#!/usr/bin/perl

# This script originally came from Ken Mitchell at Duke, kmitch@duke.edu , on 9 Feb 2007. Modified locally however. 


use strict;
use DBI;
use Getopt::Long;
use File::Basename;
use File::Copy;
use Net::FTP;
# FindBin helps us get to locally-installed modules without worrying about fully-qualified paths
use FindBin();
use lib "$FindBin::Bin";
#use Date::Manip qw(ParseDate ParseDateString UnixDate Date_Cmp);

# My own custom classes
use SfxUrlData;
use SfxUrlIndex;

# Our functions for creating SQL can create selects aimed at two differnet things:
# Actually fetching all relevant URLs for EZProxy config. Actually the
# only mode we support right now, we gave up on institutes. 
use constant FETCH_MODE_ALLURL => "FETCH_MODE_ALLURL";

#************** declare machine-specific information here  ******************
my $database = "sfxlcl3"; # mySQL database name (e.g "sfxlcl3")
my $hostname = "sfxhost.yourinstitution.edu"; # mySQL hostname (e.g. "localhost")
my $hostport = "3309"; # mySQL port (e.g. "1521")
my $user = "sfx_readonly"; # mySQL user (e.g. "sfxlcl3")
my $password = "sfx_readonly"; # mySQL user's password
#**************

my $todayErrorLogFormatted = "";
my $loggingEnabled = 0;
my $defaultGroupList = ""; # for outputting an EZProxy Group statement at the beginning of the file.  

my ($logfile_name);


#************** Initiate Log information *****************
my $logFileContents = <<END;

***********************************************************
NEW EZPROXY.CFG FILE BEING GENERATED FOR E-JOURNAL ENTRIES
Date Generated: $todayErrorLogFormatted
--- Results of EZProxy config-file generation process: ---
END

#**************

#************* compile Db connection info, system parameters *************
my $connectString = "dbi:mysql:database=" . $database . ";host=" . $hostname . ":" . $hostport . ";user=" . $user . ";password=" . $password;
#**************

my $indexerObj = SfxUrlIndex->new();

&fetchAndIndexSfxUrlInfo( $connectString , $indexerObj );

my $stdoutHandle = new IO::Handle; $stdoutHandle->fdopen(fileno(STDOUT),"w");
print $stdoutHandle "Content-Type: text/plain; charset=ISO-8859-1\n\n";
print $stdoutHandle "Group " . $defaultGroupList . "\n\n";

$indexerObj->makeEzproxyConfig($stdoutHandle);


#**************

$logFileContents .= "	Output completed and written to stdout\n";
#**************


#************* ..finish up log entry *************
$logFileContents .= <<END;
--- End results from EZProxy config-file generation process ---
***********************************************************

END
#**************

#************* ....and exit after storing log *************#
if ( $loggingEnabled ) {
	if (!(defined $logfile_name)) {
		$logfile_name = "ezproxy-config-generator.log";
	}
	open(LOGFILE,">> " . $logfile_name) or die "SCRIPT ERROR ($todayErrorLogFormatted): Can't open ". $logfile_name . ": $!\n";
	print LOGFILE $logFileContents;
	close LOGFILE;
}

exit;
#**************

# ***********************************************************
### Subroutines ####

# This is the tricky stuff, the logic and code (sql and perl) for fetching from SFX
# Comes largely from Ken @ Duke, modified by Jonathan. Including significant modifications
# to add support for institutes, which was kind of tricky. But the basic logic for
# dealing with SFX's wackiness comes, fortunately, from Ken. 


sub fetchAndIndexSfxUrlInfo {
	my ($localConnectString, $indexerObj) = @_; 

	my $sfxUnionSelectStatement = &assembleSqlUnionSelect();
	
	
	#************* connect to Db and assemble results *************
	my ($displayName, $targetName, $targetService, $URLString, $type, $defaultAvailability);
	
	my $dbHandle = DBI->connect($localConnectString) or die "SCRIPT ERROR ($todayErrorLogFormatted): Failed to connect to $database as $user.\n";
	
	$logFileContents .= "\tConnection Success! \n";
	
	my $stHandle = $dbHandle->prepare_cached($sfxUnionSelectStatement) or die "SCRIPT ERROR ($todayErrorLogFormatted): Failed to prepare query: $dbHandle->errstr";
	
	$logFileContents .= "$sfxUnionSelectStatement\n\tSelect statement prepared! \n";
	
	$stHandle->execute() or die "SCRIPT ERROR ($todayErrorLogFormatted): Failed to execute query: $dbHandle->errstr";
	
	$stHandle->bind_columns(\$displayName, \$targetName, \$targetService, \$type, 
		\$URLString, \$defaultAvailability ) or die "SCRIPT ERROR ($todayErrorLogFormatted): Failed to bind columns: $dbHandle->errstr";
	
	$logFileContents .= "\tColumns bound to variables! \n";
		
	while ($stHandle->fetch) {
		# Get URLs out of actual 'URLString', and fix errors in SFX kb. 
		my @urls = &normalizeAndExtractURLs( $URLString );
		# Now for each one make a data object, and index it.
		foreach my $url (@urls) { 
			my $sfxUrlData = SfxUrlData->new( $url );
			
			$sfxUrlData->targetName( $targetName );
			$sfxUrlData->displayName( $displayName );
			$sfxUrlData->serviceType( $targetService );
			$sfxUrlData->sourceType( $type );

			$indexerObj->addToIndex( $sfxUrlData );
		}
	}
	
	$stHandle->finish;
	$dbHandle->disconnect;
	$logFileContents .= "\tFetched and assembled all SQL entries! \n";
	#**************
	
	
	#************* Append any StaticURL Parser Exceptions ***************
	$logFileContents .= "\tAppending static URL entries... \n";
	
	my @extraStaticUrls = (
		SfxUrlData->new('http://genome.nrc.ca', 'Genome', 'NRCC_NRCC', 'getFullTxt', 'Static Exception Added'),
		SfxUrlData->new('http://canjchem.nrc.ca/', 'Canadian Journal of Chemistry', 'NRCC_NRCC', 'getFullTxt', 'Static Exception Added'),
		SfxUrlData->new('http://canjbot.nrc.ca/', 'Canadian Journal of Botany', 'NRCC_NRCC', 'getFullTxt', 'Static Exception Added'));
	for (my $i = 0; $i < @extraStaticUrls; $i++ ) {
		$indexerObj->addToIndex( $extraStaticUrls[$i] );
	}
	#**************
		
}

# Subroutines for creating SQL:
sub assembleSqlUnionSelect {
	#************* generate SQL query *************
	#  The SQL Query collects all active Portfolio Objects
	#  and Target Services whose parse_param field contains
	#  the string "http" (plus a few portfolio objects belonging
	#  to the SAGE_PUBLICATIONS target, whose URL is hard-coded
	#  into the target parser)
	#
 
	
	my $selectActiveTargetServices = &targetServiceSql();
	
	my $selectActiveObjectPortfolios = &objectPortfolioSql();
		
	my @exceptionObjectPortfolioSqlArray = &exceptionObjectPortfolioSqlArray();
	
	# now compile the regular SQL queries and the exceptions SQL statements into a union query
	
	my $selectAllExceptionsPortfolios = "";
	for (my $i; $i < @exceptionObjectPortfolioSqlArray; $i++) {
		$selectAllExceptionsPortfolios .= <<END;
		union ALL
		($exceptionObjectPortfolioSqlArray[$i])
END
	}
	
	my $selectAllActiveTargetServicesAndPortfolios = <<END;
	($selectActiveTargetServices)
	union ALL
	($selectActiveObjectPortfolios)
	$selectAllExceptionsPortfolios;
END

	return $selectAllActiveTargetServicesAndPortfolios;
}



sub targetServiceSql {
	my ($mode) = @_;
	if (undef $mode) {
		$mode = FETCH_MODE_ALLURL;
	}
	
	my $availabilityClause = &availabilityRestrictionClauseSql();
	my $sql = qq{
		select
			TARGET.PUBLIC_NAME displayName,
			TARGET.INTERNAL_NAME targetName,
			TARGET_SERVICE.SERVICE targetService,
			'Active Target' type,
			TARGET_SERVICE.PARSE_PARAM URLString,
			TARGET.AVAILABILITY DefaultAvailability
		from
			TARGET_SERVICE,
			TARGET
		where
			TARGET_SERVICE.TARGET=TARGET.INTERNAL_ID
			and TARGET.PROXY='YES'
			and TARGET_SERVICE.PARSE_PARAM like '%.%'
			and $availabilityClause
	};

	return $sql;
}
sub objectPortfolioSql {
	my $availabilityClause = &availabilityRestrictionClauseSql();
	my $selectActiveObjectPortfolios = <<END;
	select
		TITLE.TITLE_DISPLAY displayName,
		TARGET.INTERNAL_NAME targetName,
		TARGET_SERVICE.SERVICE targetService,
		'Active Object' type,
		OBJECT_PORTFOLIO.PARSE_PARAM URLString,
		TARGET.AVAILABILITY aDefaultAvailability
	from
		OBJECT_PORTFOLIO,
		TARGET_SERVICE,
		TARGET,
		TITLE
	where
		TARGET_SERVICE.TARGET=TARGET.INTERNAL_ID
		and OBJECT_PORTFOLIO.TARGET_SERVICE=TARGET_SERVICE.INTERNAL_ID
		and TITLE.OBJECT_ID=OBJECT_PORTFOLIO.OBJECT

		and TARGET.PROXY='YES'
		and OBJECT_PORTFOLIO.AVAILABILITY='ACTIVE'
		and OBJECT_PORTFOLIO.PARSE_PARAM like '%.%'
		and TITLE.TITLE_TYPE='MAIN' -- not sure what this does, Ken figured it out. 
		and $availabilityClause
END
	return $selectActiveObjectPortfolios;
}

# Certain targets/objects don't store their URLs in the normal way. We need to
# weird things to get them out, which Ken thankfully figured out!
sub exceptionObjectPortfolioSqlArray {
	# process exceptions targets (AIP_SCITATION, NRCC_NRCC, SAGE_PUBLICATIONS, etc.)
	# notes on exceptions Target Parsers (those with "http://" in the parser .pm files:
	# 	AIP::SCITATION: doesn't appear that any journals have "code=1" in their parse_params, but included as an exception
	#	APS::APS: conditions quite complex, but some journals match up, so included as an exception
	#	CATCH::CatchDOI: contains static URL pattern, NOT included because other active sources have caught it
	#	EBSCO_HOST::ebsco_am: contains static URL pattern, NOT included because other active sources have caught it
	#	ECS::ECS: contains static URL pattern in module, but NOT included because the URL is not proxiable (a DOI resolver)
	#	ELSEVIER::CARDIO: contains static URL pattern in module, but NOT included because the URL is not proxiable (a DOI resolver)
	#	EMAIL::SwitchboardEmail: contains static URL pattern in module, but NOT included because not related to proxying (email lookup)
	#	NRCC::NRCC: contains jkey URL pattern for Canadian journals (included below), contains three static journal URL patterns (included in static URL arrray), contains DOI resolver URL (not included)
	#	PubMed::CENTRAL: contains a static URL, but not proxied (not included)
	#	RSC::ARSC: contains static URLs, but these are caught in normal routines (not included as exception)
	#	SCIELO::SCIELO: contains numerous locale-specific URLs, but this is not proxied (SCIELO_FREE target)
	#	SUB::AltaVista: not a journal parser... (not included)
	#	SUB::Britannica: not a journal parser... (not included)
	#	SUB::EuroSeek: not a journal parser... (not included)
	#	SUB::Ixquick: not a journal parser...  (not included)
	#	TAYFRA::EBOOKS: Inactive Target  TAYLOR_AND_FRANCIS_EBOOKS (not included)
	#	UNION::ANTILOPE: not a journal parser, and may not be active ... (not included)
	#	UNION::COPAC: not a journal parser, and may not be active ... (not included)
	#	UNION::LIBRIS_SE: not a journal parser, and may not be active ... (not included)
	#	UNION::LOC: not a journal parser, and may not be active ... (not included)
	#	UNION::MELVYL: not a journal parser, and may not be active ... (not included)
	#	UNION::SAMPER: not a journal parser, and may not be active ... (not included)
	#	Wiley::Books: only static URL is a DOI resolver...
	
	my $standardParseParamStatement = "substring_index(OBJECT_PORTFOLIO.PARSE_PARAM , '=' , -1)";
	my $availabilityClause = &availabilityRestrictionClauseSql();
	
	my @parserExceptionsArray = (	{	"endingDomain" => ".aps.org",
			"targetParser" => "AIP:SCITATION ", 
			"nonStandardParseParamStatement" => "",
	"additionalSQL" => "\n\t\tand TARGET_SERVICE.PARSE_PARAM like '%code=1%'"},
	{	"endingDomain" => ".aps.org",
		"targetParser" => "APS::APS",
		"nonStandardParseParamStatement" => "substring_index(" . $standardParseParamStatement . ", ',' , 1)",
	"additionalSQL" => ""},
	{	"endingDomain" => ".nrc.ca",
		"targetParser" => "NRCC::NRCC",
		"nonStandardParseParamStatement" => "",
	"additionalSQL" => ""},
	{	"endingDomain" => ".sagepub.com",
		"targetParser" => "Highwire::SAGE",
		"nonStandardParseParamStatement" => "",
	"additionalSQL" => ""}
	);
	
	my @selectActiveExceptionsObjectPortfoliosArray;
	
	for (my $i; $i < @parserExceptionsArray; $i++) {
		my $endingDomain = $parserExceptionsArray[$i]{"endingDomain"};
		my $expandedParseParamStatement = $standardParseParamStatement;
		if ($parserExceptionsArray[$i]{"nonStandardParseParamStatement"} ne "") {
			$expandedParseParamStatement = $parserExceptionsArray[$i]{"nonStandardParseParamStatement"};
		}
		my $targetParser = $parserExceptionsArray[$i]{"targetParser"};
		my $additionalSQL = $parserExceptionsArray[$i]{"additionalSQL"};
		$selectActiveExceptionsObjectPortfoliosArray[$i] = <<END;
		select
			TITLE.TITLE_DISPLAY displayName,
			TARGET.INTERNAL_NAME targetName,
			TARGET_SERVICE.SERVICE targetService,
			'Active Object' type,
			concat(substring_index(OBJECT_PORTFOLIO.PARSE_PARAM , '=' , 1) , '=http://' , $expandedParseParamStatement , '$endingDomain') URLString,
			TARGET.AVAILABILITY cDefaultAvailability
		from
			OBJECT_PORTFOLIO,
			TARGET_SERVICE,
			TARGET,
			TITLE
		where
			TARGET_SERVICE.TARGET=TARGET.INTERNAL_ID
			and OBJECT_PORTFOLIO.TARGET_SERVICE=TARGET_SERVICE.INTERNAL_ID
			and TITLE.OBJECT_ID=OBJECT_PORTFOLIO.OBJECT

			and OBJECT_PORTFOLIO.AVAILABILITY='ACTIVE'
			and OBJECT_PORTFOLIO.PARSE_PARAM like '%jkey%'
			and OBJECT_PORTFOLIO.PARSE_PARAM not like '%http%'
			and $availabilityClause
			and TARGET_SERVICE.PARSER='$targetParser'
			and TARGET.PROXY='YES'
			and TITLE.TITLE_TYPE='MAIN' $additionalSQL
END
	}
	return @selectActiveExceptionsObjectPortfoliosArray;
}

sub availabilityRestrictionClauseSql {
	# Jonathan added this stuff; check for availability on Target AND
	# Target Sevice. Must be default available we do NOT include
  # targets/services set to Default inactive but with institute
  # active, the export can not handle those. 
  
  my $clause = <<END;	
	(TARGET_SERVICE.AVAILABILITY='ACTIVE')	     
	-- Adding check for TARGET active too 
	and (TARGET.AVAILABILITY = 'ACTIVE')		 
END
  
	#my $clause = <<END;	
	#(TARGET_SERVICE.AVAILABILITY='ACTIVE'
	#     or 'ACTIVE' = ( select min(tsi.AVAILABILITY)
	#		             from TARGET_SERVICE_INSTITUTE tsi
	#					 where tsi.TARGET_SERVICE_ID = TARGET_SERVICE.INTERNAL_ID))
	#-- Adding check for TARGET active too, but also check institutes. 
	#and (TARGET.AVAILABILITY = 'ACTIVE'
	#	 or 'ACTIVE' = ( select min(ti.AVAILABILITY) 
	#		             from TARGET_INSTITUTE ti
	#					 where ti.TARGET_ID = TARGET.INTERNAL_ID))
#	
#END
	return $clause;
}

sub normalizeAndExtractURLs {
	my ($parseParamString) = @_;
	
	# There's a bunch of weird ones with 'htp' as a typo for 'http'. Sigh. 
	$parseParamString =~ s/htp\:/http\:/smg;
	
	#"	...Correcting any URLs without leading 'http://' strings " Yes, this is a ridiculous thing to do,
	# attempt to pull out things that look like something=hostname.tld/foo/bar  and put a proper http:// in front. 
	# And yet it must be done. 
	$parseParamString =~ s#=(?!https?:)((\S+(?:\.\S)*)\.(com|edu|org|net|us|ca|uk)(\s|$|/))#=http://$1#sgm;
	
	# Okay, pull out the URLs. Also kind of a ridiculous thign to do, recognize urls via regexp. Sigh.  
	my @urls = ( $parseParamString =~ m#https?\://[^\s\n]+#smg        );

	return @urls;	
}

sub usage {
	my $info = <<END;
Name of Program: exproxy-config-generator.pl (EZProxy Configuration File generator for e-journals)

Usage: exproxy-config-generator.pl --filename <file_name> --logfilename <file_name>
	Required fields: --filename
	Optional fields: --logfilename
	<file_name> must be fully-qualified, or it will be stored in the directory in which this script lives

Examples:
	exproxy-config-generator.pl --filename "/home/sfx_local/ezproxy.cfg" --logfilename "/home/sfx_local/exproxy-logfile.log"
 	exproxy-config-generator.pl -f "ezproxy.cfg" -l "/home/sfx_local/exproxy-logfile.log"
END
	print $info;
}
#**************
